home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / MLDBM / Serializer / Data / Dumper.pm
Encoding:
Perl POD Document  |  1998-05-10  |  1.9 KB  |  66 lines
  1. ####################################################################
  2. package MLDBM::Serializer::Data::Dumper;
  3. BEGIN { @MLDBM::Serializer::Data::Dumper::ISA = qw(MLDBM::Serializer) }
  4.  
  5. use Data::Dumper '2.08';        # Backward compatibility
  6. use Carp;
  7.  
  8. #
  9. # Create a Data::Dumper serializer object.
  10. #
  11. sub new {
  12.     my $self = shift->SUPER::new();
  13.     my $meth = shift || "";
  14.     $meth = (defined(&Data::Dumper::Dumpxs) ? 'Dumpxs' : 'Dump')
  15.       unless $meth =~ /^Dump(xs)?$/;
  16.     $self->DumpMeth($meth);
  17.     $self->RemoveTaint(shift);
  18.     $self->Key(shift);
  19.     $self;
  20. }
  21.  
  22. #
  23. # Serialize $val if it is a reference, or if it does begin with our magic
  24. # key string, since then at retrieval time we expect a Data::Dumper string.
  25. # Otherwise, return the scalar value.
  26. #
  27. sub serialize {
  28.     my $self = shift;
  29.     my ($val) = @_;
  30.     return undef unless defined $val;
  31.     return $val unless ref($val) or $val =~ m|^\Q$self->{'key'}|o;
  32.     my $dumpmeth = $self->{'dumpmeth'};
  33.     local $Data::Dumper::Indent = 0;
  34.     local $Data::Dumper::Purity = 1;
  35.     local $Data::Dumper::Terse = 1;
  36.     return $self->{'key'} . Data::Dumper->$dumpmeth([$val], ['M']);
  37. }
  38.  
  39. #
  40. # If the value is undefined or does not begin with our magic key string,
  41. # return it as-is. Otherwise, we need to recover the underlying data structure.
  42. #
  43. sub deserialize {
  44.     my $self = shift;
  45.     my ($val) = @_;
  46.     return undef unless defined $val;
  47.     return $val unless $val =~ s|^\Q$self->{'key'}||o;
  48.     my $M = "";
  49.     ($val) = $val =~ /^(.*)$/s if $self->{'removetaint'};
  50.     # Disambiguate hashref (perl may treat it as a block)
  51.     my $N = eval($val =~ /^\{/ ? '+'.$val : $val);
  52.     return $M ? $M : $N unless $@;
  53.     carp "MLDBM error: $@\twhile evaluating:\n $val";
  54. }
  55.  
  56. sub DumpMeth    { my $s = shift; $s->_attrib('dumpmeth', @_); }
  57. sub RemoveTaint    { my $s = shift; $s->_attrib('removetaint', @_); }
  58. sub Key        { my $s = shift; $s->_attrib('key', @_); }
  59.  
  60. # avoid used only once warnings
  61. {
  62.     local $Data::Dumper::Terse;
  63. }
  64.  
  65. 1;
  66.